home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 25
/
Cream of the Crop 25.iso
/
image
/
multi207.zip
/
SKAL.BAS
< prev
next >
Wrap
BASIC Source File
|
1997-02-08
|
19KB
|
742 lines
'0.84
declare sub drwaline(byval colrbits%,byval colr%,byval x1%,byval y1%,byval x2%,byval y2%)
declare sub drwline(byval mode%,byval colr%,byval x1%,byval y1%,byval x2%,byval y2%)
declare function getmaxx%()
declare function getmaxy%()
declare sub mouseinfo(seg drvmajorver%,seg drvminorver%,seg mousetype%,seg irqnumber%)
declare sub palset(palstring$,byval firstcolr%,byval lastcolr%)
declare function pcxgetinfo%(filename$,seg pcxxsize%,seg pcxysize%,seg numcolors%,pal$)
declare function pcxmake%(byval x1%,byval y1%,byval x2%,byval y2%,filename$)
declare function pcxput%(byval mode%,byval xloc%,byval yloc%,name$)
declare function res320%()
declare function res640l%()
declare function res640%()
declare function res800%()
declare function res1024%()
declare function res1280%()
declare function restext%()
declare sub setview(byval x1%,byval y1%,byval x2%,byval y2%)
declare function videomodeget%()
declare sub videomodeset(byval mode%)
declare function whichcpu%()
declare function whichjoystick%()
declare function whichmem%()
declare function whichmouse%()
declare function whichvga%()
declare function whichxms%(seg xmskbytesavailable%,seg xmshandlesavailable%)
defint a-z
declare sub interrupt(intnum as integer,inregs as any,outregs as any)
declare function monitor%(segment)
dim file$(99)
type regtype
ax as integer
bx as integer
cx as integer
dx as integer
bp as integer
si as integer
di as integer
flags as integer
end type
dim shared inregs as regtype,outregs as regtype
count=1
getfrill$=right$(command$,1)
if getfrill$="P" or getfrill$="A" then antialia$="A"
cls
slidesho$=mid$(command$,1,2)
gosub prepares
if slidesho$="SS" then
slshow=1
goto showslid
endif
if slidesho$="/A" goto artshow
pcxshow$=mid$(command$,2,1)
if pcxshow$="S" then
pcxfilename$=mid$(command$,4)
gosub showpcx
videomodeset startvideomode
end
endif
getline:
randomize timer
gosub setpoint
l=p1
for p1=sizetype to getmaxx step 3
p4=p4-2
gosub setsymme
gosub makeline
next
if getfrill$="P" then
gosub continue:
if ucase$(a$)="C" or a$=chr$(13) then
pcxfile$="C"
countstr$=str$(count)
countstr$=ltrim$(countstr$)
countstr$=rtrim$(countstr$)
pcxfile$=pcxfile$+countstr$+".PCX"
returnco=pcxmake (0,0,getmaxx,getmaxy,pcxfile$)
if returnco<>1 then
videomodeset startvideomode
print "Unable to create .PCX file
end
endif
count=count+1
goto getline
endif
if a$=chr$(27) then
videomodeset startvideomode
end
endif
endif
a$=inkey$
if a$>"" then
videomodeset startvideomode
end
endif
goto getline
setpoint:
p1=int(rnd(1)*getmaxx)
p2=int(rnd(1)*getmaxy)
p3=int(rnd(1)*getmaxx)
p4=int(rnd(1)*getmaxy)
sw=int(rnd(1)*256)
return
setsymme:
m1=getmaxx-p1
m2=getmaxy-p2
m3=getmaxx-p3
m4=getmaxy-p4
return
makeline:
if antialia$="A" then
drwaline 3,sw,p1,p2,p3,p4
drwaline 3,sw,m1,m2,m3,m4
drwaline 3,sw,p1,m2,p3,m4
drwaline 3,sw,m1,p2,m3,p4
return
endif
drwline 1,sw,p1,p2,p3,p4
drwline 1,sw,m1,m2,m3,m4
drwline 1,sw,p1,m2,p3,m4
drwline 1,sw,m1,p2,m3,p4
return
prepares:
if command$="" goto noclp
cpu=whichcpu
if cpu<386 or cpu=9991 then
print "You need a 386SX or better for this program.
end
endif
if command$="REPORT" goto report
startvideomode=videomodeget
dummy=restext
cls
justvga$=left$(command$,1)
if justvga$="0" goto vgaonly
vga=whichvga
if vga<1 or vga>20 then
print "You need SVGA graphics capabilities for this program.
end
endif
vgaonly:
select case mid$(command$,1,2)
case "0","0A"
gosub getvga
if standard=0 then
print "You need VGA for this option."
end
endif
dummy=res320
case "1","1A","1P","1S"
dummy=res640l
videomode=1
case "2","2A","2P","2S"
dummy=res640
videomode=2
case "3","3A","3P","3S"
dummy=res800
videomode=3
case "4","4A","4P","4S"
dummy=res1024
videomode=4
case "5","5A","5P","5S"
dummy=res1280
videomode=5
case "SS"
return
case "/A"
return
case "REPORT"
goto report
case else
noclp:
cls
print "Syntax: SKAL option
print
print "Where option is one of the following:
print
print "0 - 320 X 200 X 256; better symmetry
print "0A - 320 X 200 X 256; spiffier patterns
print "1 - 640 X 400 X 256; better symmetry
print "1A - 640 X 400 X 256; spiffier patterns
print "1P - 640 X 400 X 256; screen capture (see documentation)
print "2 - 640 X 480 X 256; better symmetry
print "2A - 640 X 480 X 256; spiffier patterns
print "2P - 640 X 480 X 256; screen capture (see documentation)
print "3 - 800 X 600 X 256; better symmetry
print "3A - 800 X 600 X 256; spiffier patterns
print "3P - 800 X 600 X 256; screen capture (see documentation)
print "4 - 1024 X 768 X 256; better symmetry
print "4A - 1024 X 768 X 256; spiffier patterns
print "4P - 1024 X 768 X 256; screen capture (see documentation)
print "5 - 1280 X 1024 X 256; better symmetry
print "5A - 1280 X 1024 X 256; spiffier patterns
print "5P - 1280 X 1024 X 256; screen capture (see documentation)
print "REPORT - System information
print
print "Press a key... ";
gosub continue
cls
print ".PCX file display syntax: SKAL n filename.PCX
print
print "where n is the mode number (example: SKAL 1 TEST.PCX)
print
print "Slide show syntax: SKAL SS filelist.txt
print
print "where filelist.txt is a text file containing the mode number and a list of .PCX
print "files to display
print
print "Please see the documentation for further information."
print
end
end select
setview 0,0,getmaxx,getmaxy
return
report:
cls
cpu=whichcpu
print "Central Processing Unit: ";
select case cpu
case 134:
print "8086 or 8088"
case 9991
print "8088-2"
case 286:
print "80286"
case 386:
print "80386"
case 486:
print "80486"
case 586:
print "Pentium"
case else
print "Unknown
end select
print
print "Mouse status:
print
mouse=whichmouse
if mouse>0 then
mouseinfo mjv, mnv, tp, i
mver$=str$(mjv)
mver$=ltrim$(mver$)
mver$=rtrim$(mver$)
miver$=str$(mnv)
miver$=ltrim$(miver$)
miver$=rtrim$(miver$)
driver$=mver$+"."+miver$
print "Software driver version: "driver$
print "Mouse type: ";
select case tp
case 1
print "Bus
case 2
print "Serial
case 3
print "Inport
case 4
print "PS/2
case 5
print "HP
case else
print "Unknown
end select
print "Buttons: "str$(mouse)
print "IRQ Number: "str$(i)
else
print "No Microsoft compatible mouse detected."
endif
print
print "Joystick status: ";
joystick=whichjoystick
select case joystick
case -1
print "No joystick port detected or no joystick BIOS support present."
case 0
print "No joystick detected."
case 1
print "Joystick A is present and available."
case 2
print "Joystick B is present and available."
case 3
print "Both Joystick A and Joystick B are present and available."
end select
print
print "Extended Memory (XMS) status:
print
if whichxms(mem,handles)=1 then
xmsmem$=str$(mem)
xmsmem$=ltrim$(xmsmem$)
xmsmem$=rtrim$(xmsmem$)
xmshandl$=str$(handles)
xmshandl$=ltrim$(xmshandl$)
xmshandl$=rtrim$(xmshandl$)
print "XMS memory manager found.
print xmsmem$"K of extended memory available.
print xmshandl$" handles are available.
else
print "No XMS memory manager found.
endif
print
print "Press a key... ";
gosub continue:
cls
vga=whichvga
print "The following graphics capabilities were detected:
print
select case vga
case 0:
print "No SVGA graphics detected."
print
gosub getvideo
end
case 1:
print "Acumos AVGA2/3 SuperVGA"
case 2:
print "ATI Technologies 18/28/38/68800 SuperVGA"
case 3:
print "Ahead V5000 ver A SuperVGA"
case 4:
print "Ahead V5000 ver B SuperVGA"
case 5:
print "Chips and Technologies 82C450/1/2/3/5/6/7 SuperVGA"
case 6:
print "Cirrus Logic CL-GD 5xx,6xx,28xx,54xx,62xx SuperVGA"
case 7:
print "Everex Ev236/6xx Micro Enhancer SuperVGA"
case 8:
print "Genoa 61/62/63/64/6600 SuperVGA"
case 9:
print "NCR 77C21/22/22E/22E+ SuperVGA"
case 10:
print "Oak Technologies OTI-037C/067/077/087 SuperVGA"
case 11:
print "Paradise/Western Digital PVGA1A,WD90C00/1x/2x/3x SuperVGA"
case 12:
print "Realtek RT3106 SuperVGA"
case 13:
print "Trident 8800CS,8900B/C/CL/CX,90x0 SuperVGA"
case 14:
print "Tseng Labs ET3000-AX/BX/BP SuperVGA"
case 15:
print "Tseng Labs ET4000/W32/W32I SuperVGA"
case 16:
print "VESA compatible SuperVGA"
case 17:
print "Video 7 HT-208/16 SuperVGA"
case 18:
print "Avance Logic AL2101 SuperVGA"
case 19:
print "MXIC MX68000/10 SuperVGA"
case 20:
print "Primus P2000 SuperVGA"
case ELSE
print "Unknown type"
END SELECT
mem=whichmem
mem$=str$(mem)
mem$=ltrim$(mem$)
mem$=rtrim$(mem$)
print "Your card has "mem$"K of video memory installed."
print
print "Resolutions possible:
print
select case mem
case is>1279
print tab(4); "320 X 200 in 256 colors"
print tab(4); "640 X 400 in 256 colors"
print tab(4); "640 X 480 in 256 colors"
print tab(4); "800 X 600 in 256 colors"
print tab(4); "1024 X 768 in 256 colors"
print tab(4); "1280 X 1024 in 256 colors"
case is>1023
print tab(4); "320 X 200 in 256 colors"
print tab(4); "640 X 400 in 256 colors"
print tab(4); "640 X 480 in 256 colors"
print tab(4); "800 X 600 in 256 colors"
print tab(4); "1024 X 768 in 256 colors"
case is>511
print tab(4); "320 X 200 in 256 colors"
print tab(4); "640 X 400 in 256 colors"
print tab(4); "640 X 480 in 256 colors"
print tab(4); "800 X 600 in 256 colors"
case else
print tab(4); "640 X 400 in 256 colors"
print tab(4); "320 X 200 in 256 colors"
end select
print
print "PLEASE keep in mind that not all monitors support all resolutions."
end
getvideo:
select case monitor%(segment)
case 1
print "Monochrome detected."
print
print "Resolutions possible:
print
print "80 X 25 (text mode only)"
case 2
print "Hercules or compatible detected."
print
print "Resolutions possible:
print
print "720 X 348 X 2"
print
print "(This program cannot detect the Hercules InColor card.)
case 3
print "CGA detected."
print
print "Resolutions possible:
print "320 X 200 X 4
print "640 X 200 X 2
case 4
print "EGA detected."
print
print "Resolutions possible:
print "320 X 200 X 4
print "640 X 200 X 2
print "320 X 200 X 16
print "640 X 200 X 16
print "640 X 350 X 4
print "640 X 350 X 16
case 5
print "VGA detected."
print
print "Resolutions possible:
print
print "320 X 200 X 4
print "640 X 200 X 2
print "320 X 200 X 16
print "640 X 200 X 16
print "640 X 350 X 4
print "640 X 350 X 16
print "640 X 480 X 2
print "320 X 200 X 256
print "640 X 480 X 16
case else
print "Unable to detect video adapter."
end select
return
getvga:
select case monitor%(segment)
case 1 to 4
standard=0
case 5
standard=1
case else
standard=0
end select
return
function monitor%(segment) static
def seg=0 'first see if it's color or mono
segment=&hb800 'assume color
if peek(&h463)=&hb4 then
segment=&hb000 'assign the monochrome segment
status=inp(&h3bA) 'get the current video status
for x=1 to 30000 'test for a Hercules 30000 times
if inp(&h3ba)<>status then
monitor%=2 'the port changed, it's a Herc
exit function 'all done
endif
next
monitor% = 1 'it's a plain monochrome
else 'it's some sort of color monitor
inregs.ax=&H1A00 'first test for VGA
call interrupt(&h10,inregs,outregs)
if (outregs.ax and &hff)=&h1a then
monitor%=5 'it's a VGA
exit function 'all done
endif
inregs.ax=&h1200 'now test for EGA
inregs.bx=&h10
call interrupt(&h10,inregs,outregs)
if (outregs.bx and &hff)=&h10 then
monitor%=3 'if BL is still &H10 it's a CGA
else
monitor%=4 'otherwise it's an EGA
endif
endif
end function
showpcx:
dim pcxpal as string * 768
select case videomode
case 0:dummyval=res320
case 1:dummyval=res640l
case 2:dummyval=res640
case 3:dummyval=res800
case 4:dummyval=res1024
case 5:dummyval=res1280
case else:end
end select
setview 0,0,getmaxx,getmaxy
ok=pcxgetinfo(pcxfilename$,xsize,ysize,numcol,pcxpal)
if ok=1 then
fixit=0
for a=1 to numcol*3 step 3
r=asc(mid$(pcxpal,a,1))
g=asc(mid$(pcxpal,a+1,1))
b=asc(mid$(pcxpal,a+2,1))
if r>63 then
fixit=1
exit for
endif
if g>63 then
fixit=1
exit for
endif
if b>63 then
fixit=1
exit for
endif
next a
if fixit=1 then
for a=1 to numcol*3
c=asc(mid$(pcxpal,a,1))
mid$(pcxpal,a,1)=chr$(c\4)
next a
endif
palset pcxpal,0,255
ok=pcxput(1,0,0,pcxfilename$)
if ok<>1 then
sound 100,5
return
endif
if slshow=1 then
sleep 5
return
endif
while inkey$=""
wend
endif
return
showslid:
filelist$=mid$(command$,4)
open "i",1,filelist$
line input #1, file$(count)
videomode=val(file$(count))
while not eof(1)
count=count+1
line input #1, file$(count)
wend
close 1
count=1
while inkey$=""
if file$(count)="" or count=99 then count=1
pcxfilename$=file$(count)
gosub showpcx
count=count+1
wend
videomodeset startvideomode
end
artshow:
openfile:
videomodeset startvideomode
cls
antialia$="A"
open "i",1,"advertis.txt"
printlin:
line input #1, line$
print line$
if eof(1) then
close 1
locate ,,0
callgetm:
gosub getminut
if doreset=0 then
videomodeset startvideomode
goto screendi
endif
goto callgetm
endif
goto printlin
screendi:
whatmode$=right$(command$,1)
select case whatmode$
case "0":
dummy=res320
horizont=320
vertical=200
colors=256
setview 0,0,horizont-1,vertical-1
goto screenx
case "1":
dummy=res640l
horizont=640
vertical=400
colors=256
setview 0,0,horizont-1,vertical-1
goto screenx
case "2":
dummy=res640
horizont=640
vertical=480
colors=256
setview 0,0,horizont-1,vertical-1
goto screenx
case "3":
dummy=res800
horizont=800
vertical=600
colors=256
setview 0,0,horizont-1,vertical-1
goto screenx
case "4":
dummy=res1024
horizont=1024
vertical=768
colors=256
setview 0,0,horizont-1,vertical-1
goto screenx
case "5":
dummy=res1280
horizont=1280
vertical=1024
colors=256
setview 0,0,horizont-1,vertical-1
goto screenx
case else:end
end select
screenx:
gosub getminut
if doreset=0 then
goto openfile
endif
randomize timer
gosub setpoint
l=p1
for p1=sizetype to horizont step 3
p4=p4-2
gosub setsymme
gosub makeline
next
a$=inkey$
if a$>"" then
videomodeset startvideomode
cls
end
endif
goto screenx
getminut:
gettime$=time$
minutes$=mid$(gettime$,4,2)
minutes=val(minutes$)
if doreset=0 then
oldminut=minutes
testfive=oldminut+5
if oldminut>54 then testfive=0
doreset=1
endif
if testfive=minutes then
doreset=0
return
endif
a$=inkey$
if a$>"" then
videomodeset startvideomode
cls
end
endif
return
continue:
a$=inkey$
if a$="" goto continue:
return